home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 2003 August / MW 8 2003 CD1.iso / Inside Macworld / Product News / gimp-1.2.4.sit / gimp-1.2.4 / plug-ins / perl / UI / UI.pm < prev    next >
Encoding:
Perl POD Document  |  2003-01-14  |  31.4 KB  |  989 lines
  1. package Gimp::UI;
  2.  
  3. use Gimp ('__');
  4. use Gimp::Fu;
  5. use base 'DynaLoader';
  6.  
  7. BEGIN {
  8.    $VERSION = 1.211;
  9.    eval {
  10.       require XSLoader;
  11.       XSLoader::load Gimp::UI $VERSION;
  12.    } or do {
  13.       require DynaLoader;
  14.       @ISA=qw(DynaLoader);
  15.       bootstrap Gimp::UI $VERSION;
  16.    }
  17. }
  18.  
  19. =head1 NAME
  20.  
  21. Gimp::UI - "simulation of libgimpui", and more!
  22.  
  23. =head1 SYNOPSIS
  24.  
  25.   use Gimp::UI;
  26.  
  27. =head1 DESCRIPTION
  28.  
  29. Due to the braindamaged (read: "unusable") libgimpui API, I had to
  30. reimplement all of it in perl.
  31.  
  32. =over 4
  33.  
  34.  $option_menu = new Gimp::UI::ImageMenu
  35.  $option_menu = new Gimp::UI::LayerMenu
  36.  $option_menu = new Gimp::UI::ChannelMenu
  37.  $option_menu = new Gimp::UI::DrawableMenu (constraint_func, active_element, \var);
  38.  
  39.  $button = new Gimp::UI::PatternSelect;
  40.  $button = new Gimp::UI::BrushSelect;
  41.  $button = new Gimp::UI::GradientSelect;
  42.  
  43.  $button = new Gimp::UI::ColorSelectButton;
  44.  
  45. =back
  46.  
  47. =cut
  48.  
  49. if (eval { require Gtk; import Gtk (); 1 }) {
  50.    local $/;
  51.    eval <DATA>;
  52.    die $@ if $@;
  53.    close DATA;
  54. }
  55.  
  56. 1;
  57.  
  58. # All Gtk-dependent functions are put below
  59. __DATA__
  60. #line 58
  61.  
  62. @Gimp::UI::ImageMenu::ISA   =qw(Gimp::UI);
  63. @Gimp::UI::LayerMenu::ISA   =qw(Gimp::UI);
  64. @Gimp::UI::ChannelMenu::ISA =qw(Gimp::UI);
  65. @Gimp::UI::DrawableMenu::ISA=qw(Gimp::UI);
  66.  
  67. sub image_name {
  68.    my $name = $_[0]->get_filename;
  69.    $name.="-".${$_[0]} if $name eq "Untitled";
  70.    $name;
  71. }
  72.  
  73. sub Gimp::UI::ImageMenu::_items {
  74.   map [[$_],$_,image_name($_)],
  75.       Gimp->image_list ();
  76. }
  77. sub Gimp::UI::LayerMenu::_items {
  78.   map { my $i = $_; map [[$i,$_],$_,image_name($i)."/".$_->get_name],$i->get_layers }
  79.       Gimp->image_list ();
  80. }
  81.  
  82. sub Gimp::UI::ChannelMenu::_items {
  83.   map { my $i = $_; map [[$i,$_],$_,image_name($i)."/".$_->get_name],$i->get_channels }
  84.       Gimp->image_list ();
  85. }
  86.  
  87. sub Gimp::UI::DrawableMenu::_items {
  88.   map { my $i = $_; map [[$i,$_],$_,image_name($i)."/".$_->get_name],($i->get_layers, $i->get_channels) }
  89.       Gimp->image_list ();
  90. }
  91.  
  92. sub new($$$$) {
  93.    my($class,$constraint,$active,$var)=@_;
  94.    my(@items)=$class->_items;
  95.    my $menu = new Gtk::Menu;
  96.    for(@items) {
  97.       my($constraints,$result,$name)=@$_;
  98.       next unless $constraint->(@{$constraints});
  99.       my $item = new Gtk::MenuItem $name;
  100.       $item->signal_connect(activate => sub { $$var=$result });
  101.       $menu->append($item);
  102.    }
  103.    if (@items) {
  104.       $$var=$items[0]->[1];
  105.    } else {
  106.       my $item = new Gtk::MenuItem __"(none)";
  107.       $menu->append($item);
  108.       $$var=undef;
  109.    }
  110.    $menu->show_all;
  111.    $menu;
  112. }
  113.  
  114. package Gimp::UI::PreviewSelect;
  115.  
  116. use Gimp '__';
  117.  
  118. sub GTK_CLASS_INIT {
  119.    my $class = shift;
  120.    add_arg_type $class "active", "GtkString", 3;
  121. }
  122.  
  123. sub GTK_OBJECT_SET_ARG {
  124.    my($self,$arg,$id,$value) = @_;
  125.    if ($arg eq "active") {
  126.       my $count;
  127.       
  128.       if (!defined $self->{value} || $value ne $self->{value}) {
  129.          $self->{value}=$value=$self->set_preview($value);
  130.          $self->{label}->set($value);
  131.          $self->{list}->foreach(sub {
  132.             if ($_[0]->children->get eq $value) {
  133.                $self->{list}->select_item($count);
  134.             };
  135.             $count++;
  136.          });
  137.       }
  138.    }
  139. }
  140.  
  141. sub GTK_OBJECT_GET_ARG {
  142.    my($self,$arg,$id) = @_;
  143.    $self->{label}->get;
  144. }
  145.  
  146. sub GTK_OBJECT_INIT {
  147.    my $self = shift;
  148.    (my $label = new Gtk::Label "")->show;
  149.    $self->add($label);
  150.    $self->{label}=$label;
  151.    
  152.    my $w = new Gtk::Dialog;
  153.    $w->set_title($self->get_title);
  154.    $w->set_usize(400,300);
  155.    $w->action_area->set_border_width(2);
  156.    $w->action_area->set_homogeneous(0);
  157.    
  158.    (my $h=new Gtk::HBox 0,0)->show;
  159.    $w->vbox->pack_start($h,1,1,0);
  160.    
  161.    (my $preview = $self->new_preview)->show;
  162.    
  163.    (my $s=new Gtk::ScrolledWindow undef,undef)->show;
  164.    $s->set_policy(-automatic, -automatic);
  165.    $s->set_usize(200,300);
  166.    $h->pack_start($s,1,1,0);
  167.    $h->pack_start($preview,1,1,0);
  168.    
  169.    my $l=new Gtk::List;
  170.    $l->set_selection_mode(-single);
  171.    $l->set_selection_mode(-browse);
  172.    $self->{list}=$l;
  173.    
  174.    for(sort $self->get_list) {
  175.       $l->add(new Gtk::ListItem $_);
  176.    }
  177.    
  178.    $l->show_all;
  179.    $l->signal_connect("selection_changed",sub {
  180.       $l->selection and
  181.          $self->set_preview($l->selection->children->get);
  182.    });
  183.    $s->add_with_viewport ($l);
  184.  
  185.    my $hbbox = new Gtk::HButtonBox;
  186.    $hbbox->set_spacing(4);
  187.    $w->action_area->pack_end($hbbox,0,0,0);
  188.    show $hbbox;
  189.  
  190.    my $button = new Gtk::Button __"OK";
  191.    signal_connect $button "clicked", sub {
  192.       hide $w;
  193.       if($l->selection) {
  194.          my $p = $l->selection->children->get;
  195.          $label->set($p);
  196.       }
  197.    };
  198.    $hbbox->pack_start($button,0,0,0);
  199.    can_default $button 1;
  200.    grab_default $button;
  201.    show $button;
  202.    
  203.    $button = new Gtk::Button __"Cancel";
  204.    signal_connect $button "clicked", sub {hide $w};
  205.    $hbbox->pack_start($button,0,0,0);
  206.    can_default $button 1;
  207.    show $button;
  208.    
  209.    $self->signal_connect("clicked",sub {show $w});
  210. }
  211.  
  212. package Gimp::UI::PatternSelect;
  213.  
  214. use Gimp '__';
  215. use Gimp::basewidget Gtk::Button;
  216.  
  217. sub GTK_CLASS_INIT    { goto &Gimp::UI::PreviewSelect::GTK_CLASS_INIT     }
  218. sub GTK_OBJECT_SET_ARG    { goto &Gimp::UI::PreviewSelect::GTK_OBJECT_SET_ARG }
  219. sub GTK_OBJECT_GET_ARG    { goto &Gimp::UI::PreviewSelect::GTK_OBJECT_GET_ARG }
  220. sub GTK_OBJECT_INIT    { goto &Gimp::UI::PreviewSelect::GTK_OBJECT_INIT    }
  221.  
  222. sub get_title { __"Pattern Selection Dialog" }
  223. sub get_list { Gimp->patterns_list }
  224.  
  225. sub new_preview {
  226.    my $self = shift;
  227.    my $cp = $self->{"color_preview"}=new Gtk::Preview "color";
  228.    my $gp = $self->{"gray_preview"} =new Gtk::Preview "grayscale";
  229.    my $preview = new Gtk::HBox 0,0;
  230.    $preview->add($cp);
  231.    $preview->add($gp);
  232.    $preview;
  233. }
  234.  
  235. sub set_preview {
  236.    my $self = shift;
  237.    my $value = shift;
  238.    
  239.    my $cp = $self->{"color_preview"};
  240.    my $gp = $self->{"gray_preview"};
  241.    
  242.    my ($name,$w,$h,$bpp,$mask)=Gimp->patterns_get_pattern_data ($value);
  243.    unless (defined $name) {
  244.       $name=Gimp->patterns_get_pattern;
  245.       ($name,$w,$h,$bpp,$mask)=Gimp->patterns_get_pattern_data ($name);
  246.    }
  247.    hide $cp;
  248.    hide $gp;
  249.    my $p = $bpp == 1 ? $gp : $cp;
  250.    $p->size ($w, $h);
  251.    for(0..$h-1) {
  252.       $p->draw_row (substr ($mask, $w*$bpp*$_), 0, $_, $w);
  253.    }
  254.    $p->draw(undef);
  255.    show $p;
  256.    
  257.    $name;
  258. }
  259.  
  260. package Gimp::UI::BrushSelect;
  261.  
  262. use Gimp '__';
  263. use Gimp::basewidget Gtk::Button;
  264.  
  265. sub GTK_CLASS_INIT    { goto &Gimp::UI::PreviewSelect::GTK_CLASS_INIT     }
  266. sub GTK_OBJECT_SET_ARG    { goto &Gimp::UI::PreviewSelect::GTK_OBJECT_SET_ARG }
  267. sub GTK_OBJECT_GET_ARG    { goto &Gimp::UI::PreviewSelect::GTK_OBJECT_GET_ARG }
  268. sub GTK_OBJECT_INIT    { goto &Gimp::UI::PreviewSelect::GTK_OBJECT_INIT    }
  269.  
  270. sub get_title { __"Brush Selection Dialog" }
  271. sub get_list { Gimp->brushes_list }
  272.  
  273. sub new_preview {
  274.    my $self=shift;
  275.    $self->{"preview"}=new Gtk::Preview "grayscale";
  276. }
  277.  
  278. sub set_preview {
  279.    my $self = shift;
  280.    my $value = shift;
  281.    
  282.    my $p = $self->{"preview"};
  283.    
  284.    my ($name,$opacity,$spacing,$mode,$w,$h,$mask)=eval { Gimp->brushes_get_brush_data ($value) };
  285.    if ($@) {
  286.       $name=Gimp->brushes_get_brush;
  287.       ($name,$opacity,$spacing,$mode,$w,$h,$mask)=Gimp->brushes_get_brush_data ($name);
  288.    }
  289.    $mask=pack("C*",@$mask);
  290.    $xor="\xff" x $w;
  291.    hide $p;
  292.    my $l=length($mask);
  293.    $p->size ($w, $h);
  294.    for(0..$h-1) {
  295.      $p->draw_row (substr ($mask, $w*$_) ^ $xor, 0, $_, $w);
  296.    }
  297.    $p->draw(undef);
  298.    show $p;
  299.    
  300.    $name;
  301. }
  302.  
  303. package Gimp::UI::GradientSelect;
  304.  
  305. use Gimp '__';
  306. use Gimp::basewidget Gtk::Button;
  307.  
  308. sub GTK_CLASS_INIT    { goto &Gimp::UI::PreviewSelect::GTK_CLASS_INIT     }
  309. sub GTK_OBJECT_SET_ARG    { goto &Gimp::UI::PreviewSelect::GTK_OBJECT_SET_ARG }
  310. sub GTK_OBJECT_GET_ARG    { goto &Gimp::UI::PreviewSelect::GTK_OBJECT_GET_ARG }
  311. sub GTK_OBJECT_INIT    { goto &Gimp::UI::PreviewSelect::GTK_OBJECT_INIT    }
  312.  
  313. sub get_title { __"Gradient Selection Dialog" }
  314. sub get_list { keys %gradients }
  315.  
  316. sub new_preview {
  317.    my $self = shift;
  318.    new Gtk::Frame;
  319. }
  320.  
  321. sub set_preview {
  322.    my $self = shift;
  323.    my $value = shift;
  324.    exists $gradients{$value} ? $value : Gimp->gradients_get_active;
  325. }
  326.  
  327. sub new {
  328.    unless (defined %gradients) {
  329.       undef @gradients{Gimp->gradients_get_list};
  330.    }
  331.    Gtk::Object::new @_;
  332. }
  333.  
  334. package Gimp::UI::ColorSelectButton;
  335.  
  336. use Gimp '__';
  337. use Gimp::basewidget Gtk::Button;
  338.  
  339. # Class defaults data
  340. my @class_def_color = (255,175,0);
  341.  
  342. sub GTK_CLASS_INIT {
  343.     my($class) = shift;
  344.     add_arg_type $class "color", "GtkString", 3; #R/W
  345. }
  346.  
  347. sub GTK_OBJECT_INIT {
  348.     my (@color) = @class_def_color;
  349.     
  350.     shift unless ref $_[0];
  351.     my($color_button) = @_;
  352.     
  353.     $color_button->{_color} ||= [@color];
  354.  
  355.     my $preview = new Gtk::Preview -color;
  356.     
  357.     $color_button->{_preview} = $preview;
  358.     
  359.     # work around funny bug somewhere in gtk...
  360.     $preview->size(300,50);
  361.     $preview->show;
  362.     $color_button->add($preview);
  363.         
  364.     signal_connect $color_button "size_allocate" => sub {
  365.         my($self,$allocation) = @_;
  366.         my($x,$y,$w,$h) = @$allocation;
  367.         $w -= 6;
  368.         $h -= 6;
  369.         $self->{_preview_width} = $w;
  370.         $self->{_preview_height} = $h;
  371.         $self->{_preview}->size($self->{_preview_width},$self->{_preview_height});
  372.         $self->update_color;
  373.     };
  374.     
  375.     signal_connect $color_button "clicked" => \&cb_color_button;
  376. }
  377.  
  378. sub GTK_OBJECT_SET_ARG {
  379.    my($self,$arg,$id, $value) = @_;
  380.    $self->{_color} = [split(' ',$value)];
  381.    $self->update_color;
  382. }
  383.  
  384. sub GTK_OBJECT_GET_ARG {
  385.    my($self,$arg,$id) = @_;
  386.    return join(' ',@{$self->{_color}});
  387. }
  388.  
  389. sub update_color($) {
  390.     my($this) = shift;
  391.     
  392.     return unless defined $this->{_preview} and defined $this->{_preview_width};
  393.     
  394.     my($preview, $color) = ($this->{_preview}, $this->{_color});
  395.     my($width, $height) = ($this->{_preview_width}, $this->{_preview_height});
  396.     
  397.     my($buf) = pack("C3", @$color) x $width;
  398.  
  399.     for(0..$height-1) {
  400.        $preview->draw_row($buf, 0, $_, $width);
  401.     }
  402.     $preview->draw(undef);
  403. }
  404.  
  405. sub color_selection_ok {
  406.     my($widget, $dialog, $color_button) = @_;
  407.     
  408.     my(@color) = $dialog->colorsel->get_color;
  409.     @{$color_button->{_color}} = map(int(255.99*$_),@color);
  410.  
  411.     $color_button->update_color();
  412.     $dialog->destroy();
  413.     delete $color_button->{_cs_window};
  414. }
  415.  
  416. sub cb_color_button {
  417.     my($color_button) = @_;
  418.     
  419.     if (defined $color_button->{_cs_window}) {
  420.         if (!$color_button->{_cs_window}->mapped) {
  421.             $color_button->{_cs_window}->hide;
  422.         }
  423.         $color_button->{_cs_window}->show;
  424.         $color_button->{_cs_window}->window->raise;
  425.         return;
  426.     }
  427.  
  428.     my $cs_window=new Gtk::ColorSelectionDialog(__"Color");
  429.     $cs_window->colorsel->set_color(map($_*1/255,@{$color_button->{_color}}));
  430.     $cs_window->show();
  431.     $cs_window->ok_button->signal_connect("clicked",
  432.                       \&color_selection_ok,
  433.                       $cs_window,
  434.                       $color_button);
  435.     $cs_window->cancel_button->signal_connect("clicked",
  436.                           sub { $cs_window->destroy; delete $color_button->{_cs_window} });
  437.     $color_button->{_cs_window} = $cs_window;
  438. }
  439.  
  440. package Gimp::UI;
  441.  
  442. sub logo {
  443.    &logo_xpm;
  444. }
  445.  
  446. sub logo_xpm {
  447.    my $window=shift;
  448.    new Gtk::Pixmap(Gtk::Gdk::Pixmap->create_from_xpm_d($window->window,undef,
  449.       #%XPM:logo%
  450.       '108 33 18 1', '  c #030305', '. c #181818', 'X c #222221', 'o c Gray19',
  451.       'O c Gray25', '+ c #4e4e4f', '@ c #606060', '# c #777776', '$ c #8a8a89',
  452.       '% c #a0a09f', '& c #b7b7b7', '* c #c7c7c6', '= c #d5d5d4', '- c gainsboro',
  453.       '; c #e5e5e4', ': c #fbfbf9', '> c Gray100', ', c None',
  454.       ',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,',
  455.       ',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,:::::,,,,,:::,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,#@@$&,,,,,,,,,',
  456.       ',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,:;$@+#&::,,:@+-,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,&#@%,,,,,,,#++$+O%&,,,,,,,,',
  457.       ',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,:%.     O-:,%  #:,,,,,,,,,,,,,,,,,,,,,,,,,,,+$#+#+#%,,,,,#OOO+@++%%,,,,,,,',
  458.       ',,,,,,,,,,,,,,,,,,,,,,,,,,,,,#,,,:%   .X   X;,=. &:,,,,,,,,,,,,,,,,,,,,,,,,,,+@$%@@@@#,,,,,OoXoo++O##,,,,,,,',
  459.       ',,,,,,&,,,,,,,,,,,,,,,,,,,,,##,,,:.  #::*XO&:,:::::::::;&-::;&-:,:::::**::,,,###&$#+oo#,,,+XXoXX#%@+@*,,,,,,',
  460.       ',,,,,,&&,,,,,,,,,,,,,,,,,,,,##,,*&  O:::::::::&  %:#  %.  #$   %:;  $o  X*:,,,#++#&+o+$,#OO#OoXO#&%@O#,,,,,,',
  461.       ',,,,,,,%%,,,,,,,,,,,,,,,,,,#@@,,;#  $::@OOOOO:&  %:#  .+   .O  .:;   ..  X:,,,,+o+#o+O$#OOO#$O+$%*;%$#$,,,,,',
  462.       ',,,,,,,%%$,,,,,,,,,,,,,,,,@@@@,,;#  $::X    .:&  %:#  *:@  *:+  ;;  O::+  &,,,,+o++#@@$Oo+$&=#&%%&-*$#@,,,,,',
  463.       ',,,,,,,,%$#@,,,,,,,,,,,,@@@@@@,,-%  @::%$$  X:&  %:#  ;:#  ::#  ;;  %:,&  %:,,,@@$@Oo+#XO@&;=%@+#@#%@@$$,,,,',
  464.       ',,,,,,,,%$##@,,,,,,,,,###@@@++,,,;.  *:::%  @:&  %:#  ::#  ::#  ;;  $::%  %,,,,+O#+O+#+o#%&;=&%&#$+%&%%#,,,,',
  465.       ',,,,,,,,$$$#####,,,@@@@@@@@++,,,,:$  .@$+  .=,&  %:#  ::#  ::#  ;;  .%%.  =,,,,@+@%@#%Oo@@-;-*&%&%*;;*%+$,,,',
  466.       ',,,,,,,,*&$$#$%$##@@@@@@@+++O,,,,,:#      .&:,&  %:#  ::#  ::#  ;;  X    @:,,,,#oO$##%#oo@*=&$&$%&=::%&#+$,,',
  467.       ',,,,,,,;::;$*:::&#@@@++++++O,,,,,,,:*#OO+$;:,,=##*:&##::&##::&##:;  $%OO$:,,,,,#oo#&#&$Ooo$*#%$$$#%=&O##+@,,',
  468.       ',,Xo..$:;%*-::;;;%@@++OOOOO,,,,,,,,,,:::::,,,,::::,:::,,:::,,:::,;  $::::,,,,,,,+o@%%*%+O.#$+%*#@+#@oX@++@,,',
  469.       ',X#%+X@;%Oo;:;%+&%@@+OOOOo,,,,,,,,,,,,,,,,,,,::::::::,,,,,,,,,,,,;  $:,,,,,,,,,,%+O@**$oo.##@&%+oooo.X@+O+$,',
  470.       ',X$&+oO$&o@&:=+.#$@++OOOo,,,,,,,,,,,,,,,,,,,,=$$$$$$$=,,,,,,,,,,,;oX%:,,,,,,,,,,,%++@$XXX.X+#&##OOOOoo#@@+,,',
  471.       ',.+@OO+@###$*=#+$@@+OOOOo,,,,,,,,,,::::,,,,,,%       &,,,,,,::::,::::,,,,,,,,,,,,,$@O@O...X.O$#%OXX@@@+@++,,',
  472.       ',.oOO+@@@####$$$@@++OOOoX,,,,,,,,,-&&&&&-:,,,-%%%%%%%-,,,,,:#  -,,,,,,,,,,,,,,,,,,,,&,OXOo#@O+o$oXo,#+@O@%,,',
  473.       ',.oO+@#@@@###@@@@OOOOOOo,,,,,,,,,:%      @:,,,:::::::,,,,,,:#  =,,,,,,,,,,,,,,,,,,,,,,@oXo,OooO$OX+,,+O+%,,,',
  474.       ',,O+@##+++@@@@@+Oo@OOOoX,,,,,,,,,:%       $:,,,,,,,,,,,,,,,:#  =,,,,,,,,,,,,,,,,,,,,,,@oXO,Ooo#,Oo@,,@oO,,,,',
  475.       ',,o+##@OO++++OOoo+#OOoX,,,,,,,,,,:%  $;%  O:,::*=::,,:::::;:#  =,,,,,,,,,,,,,,,,,,,,,,@oo@@ooo@,++@,,%OO,,,,',
  476.       ',,,,OOooooXXXXoO+@+OoX,,,,,,,,,,,:%  $:;  o::$.  X%::%..*o %#  =,,,,,,,,,,,,,,,,,,,,,,@O+,@@@@$,+$%,,,++,,,,',
  477.       ',,,,,,... ..oO+@+OX.,,,,,,,,,,,,,:%  +$O  +:$ .#@  &:$  o  *#  =,,,,,,,,,,,,,,,,,,,,,,#O+,+#&,,,$*@,,,+@,,,,',
  478.       ',,,,,,,,,,.....X.,,,,,,,,,,,,,,,,:%       %;. #--o +:$  .%&:#  =,,,,,,,,,,,,,,,,,,,,,,,@@,,O%&,,%=,,,,@#,,,,',
  479.       ',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,:%    .o%:*       .:$  %:,:#  =,,,,,,,,,,,,,,,,,,,,,,,+@,,,+&,#&,,,,,#@,,,,',
  480.       ',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,:%  $::::,*  #%%%%&:$  *,,:#  =,,,,,,,,,,,,,,,,,,,,,,,#@,,,,@-%&,,,,,$#,,,,',
  481.       ',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,:%  $:,,,,:. #::$%::$  *,,:#  =,,,,,,,,,,,,,,,,,,,,,,,@&,,,,,@-$,,,,,$%,,,,',
  482.       ',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,:%  $:,,,,:%  X.  %:$  *,,:#  =,,,,,,,,,,,,,,,,,,,,,,$%,,,,,$@+%&,,,,@%,,,,',
  483.       ',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,:*@@&:,,,,,:*+XX+&::&@@-,,:%@@;,,,,,,,,,,,,,,,,,,,,,,$=,,,,@@##+#,,,@%&,,,,',
  484.       ',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,::::,,,,,,,::::::,,::::,,,::::,,,,,,,,,,,,,,,,,,,,,%$*,,,,$%&,@,,,,@+@,,,,',
  485.       ',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,+@%#,,,,,,,,,,,,,@@#,,,,',
  486.       ',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,o$&,,,,,,,,,,,,,,,,,,,,,'
  487.       #%XPM%
  488.    ))
  489. }
  490.  
  491. sub _new_adjustment {
  492.    my @adj = eval { @{$_[1]} };
  493.  
  494.    $adj[2]||=($adj[1]-$adj[0])*0.01;
  495.    $adj[3]||=($adj[1]-$adj[0])*0.01;
  496.    $adj[4]||=0;
  497.    
  498.    new Gtk::Adjustment $_[0],@adj;
  499. }
  500.  
  501. # find a suitable value for the "digits" value
  502. sub _find_digits {
  503.    my $adj = shift;
  504.    my $digits = log($adj->step_increment || 1)/log(0.1);
  505.    $digits>0 ? int $digits+0.9 : 0;
  506. }
  507.  
  508. sub help_window(\$$$) {
  509.    my($helpwin,$blurb,$help)=@_;
  510.    unless ($$helpwin) {
  511.       $$helpwin = new Gtk::Dialog;
  512.       $$helpwin->set_title(__("Help for ").$Gimp::function);
  513.       $$helpwin->action_area->set_border_width(2);
  514.       my($font,$b);
  515.  
  516.       $b = new Gtk::Text;
  517.       $b->set_editable (0);
  518.       $b->set_word_wrap (1);
  519.  
  520.       $font = load Gtk::Gdk::Font __"9x15bold";
  521.       $font = fontset_load Gtk::Gdk::Font __"-*-courier-medium-r-normal--*-120-*-*-*-*-*" unless $font;
  522.       $font = $b->style->font unless $font;
  523.       my $cs = new Gtk::ScrolledWindow undef,undef;
  524.       $cs->set_policy(-automatic,-automatic);
  525.       $cs->add($b);
  526.       $$helpwin->vbox->add($cs);
  527.       $b->insert($font,$b->style->fg(-normal),undef,__"BLURB:\n\n$blurb\n\nHELP:\n\n$help");
  528.       $b->set_usize($font->string_width('M')*80,($font->ascent+$font->descent)*26);
  529.  
  530.       my $button = Gtk::Button->new(__"OK");
  531.       signal_connect $button "clicked",sub { hide $$helpwin };
  532.       $$helpwin->action_area->add($button);
  533.       
  534.       $$helpwin->signal_connect("destroy",sub { undef $$helpwin });
  535.  
  536.       Gtk->idle_add(sub {
  537.          require Gimp::Pod;
  538.          my $pod = new Gimp::Pod;
  539.          my $text = $pod->format;
  540.          if ($text) {
  541.             $b->insert($font,$b->style->fg(-normal),undef,__"\n\nEMBEDDED POD DOCUMENTATION:\n\n");
  542.             $b->insert($font,$b->style->fg(-normal),undef,$text);
  543.          }
  544.       });
  545.    }
  546.  
  547.    $$helpwin->show_all();
  548. }
  549. sub interact($$$$@) {
  550.    local $^W=0;
  551.    my($function)=shift;
  552.    my($blurb)=shift;
  553.    my($help)=shift;
  554.    my(@types)=@{shift()};
  555.    my(@getvals,@setvals,@lastvals,@defaults);
  556.    my($button,$box,$bot,$g);
  557.    my($helpwin);
  558.    my $res=0;
  559.    my @res;
  560.  
  561.    Gimp::gtk_init;
  562.  
  563.    my $gimp_10 = Gimp->major_version==1 && Gimp->minor_version==0;
  564.    
  565.    my $t = new Gtk::Tooltips;
  566.    my $w = new Gtk::Dialog;
  567.    my $accel = new Gtk::AccelGroup;
  568.  
  569.    for(;;) {
  570.      $accel->attach($w);
  571.  
  572.      set_title $w $Gimp::function;
  573.      $w->action_area->set_border_width(2);
  574.      $w->action_area->set_homogeneous(0);
  575.  
  576.      my $h = new Gtk::HBox 0,2;
  577.      $h->add(new Gtk::Label Gimp::wrap_text($blurb,40));
  578.      $w->vbox->pack_start($h,1,1,0);
  579.      realize $w;
  580.      my $l = logo($w);
  581.      $h->add($l);
  582.      
  583.      $g = new Gtk::Table scalar@types,2,0;
  584.      $g->border_width(4);
  585.      $w->vbox->pack_start($g,1,1,0);
  586.  
  587.      for(@types) {
  588.         my($label,$a);
  589.         my($type,$name,$desc,$default,$extra)=@$_;
  590.         my($value)=shift;
  591.         
  592.         local *new_PF_STRING = sub {
  593.            my $e = new Gtk::Entry;
  594.            set_usize $e 0,25;
  595.            push(@setvals,sub{set_text $e defined $_[0] ? $_[0] : ""});
  596.            #select_region $e 0,1;
  597.            push(@getvals,sub{get_text $e});
  598.            $a=$e;
  599.         };
  600.  
  601.         if($type == PF_ADJUSTMENT) { # support for scm2perl
  602.            my(@x)=@$default;
  603.            $default=shift @x;
  604.            $type = pop(@x) ? PF_SPINNER : PF_SLIDER;
  605.            $extra=[@x];
  606.         }
  607.         
  608.         $value=$default unless defined $value;
  609.         # massage label text a small bit (works only for english)
  610.         $label="$name: ";
  611.         $label =~ y/_/ /; $label =~ s/^(\w)/\U$1/g;
  612.         
  613.         if($type == PF_INT8        # perl just maps
  614.         || $type == PF_INT16        # all this crap
  615.         || $type == PF_INT32        # into the scalar
  616.         || $type == PF_FLOAT        # domain.
  617.         || $type == PF_STRING) {    # I love it
  618.            &new_PF_STRING;
  619.            
  620.         } elsif($type == PF_FONT) {
  621.            my $fs=new Gtk::FontSelectionDialog __"Font Selection Dialog ($desc)";
  622.            my $def = __"-*-helvetica-medium-r-normal-*-34-*-*-*-p-*-iso8859-1";
  623.            my $val;
  624.            
  625.            my $l=new Gtk::Label "!error!";
  626.            my $setval = sub {
  627.               $val=$_[0];
  628.               unless (defined $val && $fs->set_font_name ($val)) {
  629.                  warn __"Illegal default font description for $function: $val\n" if defined $val;
  630.                  $val=$def;
  631.                  $fs->set_font_name ($val);
  632.               }
  633.               
  634.               my($n,$t)=Gimp::xlfd_size($val);
  635.               $l->set((split(/-/,$val))[2]."\@$n".($t ? "p" : ""));
  636.            };
  637.            
  638.            $fs->ok_button->signal_connect("clicked",sub {$setval->($fs->get_font_name); $fs->hide});
  639.            $fs->cancel_button->signal_connect("clicked",sub {$fs->hide});
  640.            
  641.            push(@setvals,$setval);
  642.            push(@getvals,sub { $val });
  643.            
  644.            $a=new Gtk::Button;
  645.            $a->add($l);
  646.            $a->signal_connect("clicked", sub { show $fs });
  647.            
  648.         } elsif($type == PF_SPINNER) {
  649.            my $adj = _new_adjustment ($value,$extra);
  650.            $a=new Gtk::SpinButton $adj,1,0;
  651.            $a->set_digits (_find_digits $adj);
  652.            $a->set_usize (120,0);
  653.            push(@setvals,sub{$adj->set_value($_[0])});
  654.            push(@getvals,sub{$adj->get_value});
  655.            
  656.         } elsif($type == PF_SLIDER) {
  657.            my $adj = _new_adjustment ($value,$extra);
  658.            $a=new Gtk::HScale $adj;
  659.            $a->set_digits (_find_digits $adj);
  660.            $a->set_usize (120,0);
  661.            push(@setvals,sub{$adj->set_value($_[0])});
  662.            push(@getvals,sub{$adj->get_value});
  663.            
  664.         } elsif($type == PF_COLOR) {
  665.            $a=new Gtk::HBox (0,5);
  666.            my $b=new Gimp::UI::ColorSelectButton -width => 90, -height => 18;
  667.            $a->pack_start ($b,1,1,0);
  668.            $default = [216, 152, 32] unless defined $default;
  669.            push(@setvals,sub{$b->set('color', "@{defined $_[0] ? Gimp::canonicalize_color $_[0] : [216,152,32]}")});
  670.            push(@getvals,sub{[split ' ',$b->get('color')]});
  671.            set_tip $t $b,$desc;
  672.            
  673.            my $c = new Gtk::Button __"FG";
  674.            signal_connect $c "clicked", sub {
  675.              $b->set('color', "@{Gimp::Palette->get_foreground}");
  676.            };
  677.            set_tip $t $c,__"get current foreground colour from the gimp";
  678.            $a->pack_start ($c,1,1,0);
  679.            
  680.            my $d = new Gtk::Button __"BG";
  681.            signal_connect $d "clicked", sub {
  682.              $b->set('color', "@{Gimp::Palette->get_background}");
  683.            };
  684.            set_tip $t $d,__"get current background colour from the gimp";
  685.            $a->pack_start ($d,1,1,0);
  686.            
  687.         } elsif($type == PF_TOGGLE) {
  688.            $a=new Gtk::CheckButton $desc;
  689.            push(@setvals,sub{set_state $a ($_[0] ? 1 : 0)});
  690.            push(@getvals,sub{state $a eq "active"});
  691.            
  692.         } elsif($type == PF_RADIO) {
  693.            my $b = new Gtk::HBox 0,5;
  694.            my($r,$prev);
  695.            my $prev_sub = sub { $r = $_[0] };
  696.            while (@$extra) {
  697.               my $label = shift @$extra;
  698.               my $value = shift @$extra;
  699.               my $radio = new Gtk::RadioButton $label;
  700.               $radio->set_group ($prev) if $prev;
  701.               $b->pack_start ($radio,1,0,5);
  702.               $radio->signal_connect(clicked => sub { $r = $value });
  703.               my $prev_sub_my = $prev_sub;
  704.               $prev_sub = sub { $radio->set_active ($_[0] eq $value); &$prev_sub_my };
  705.               $prev = $radio;
  706.            }
  707.            $a = new Gtk::Frame;
  708.            $a->add($b);
  709.            push(@setvals,$prev_sub);
  710.            push(@getvals,sub{$r});
  711.            
  712.         } elsif($type == PF_IMAGE) {
  713.            my $res;
  714.            $a=new Gtk::HBox (0,5);
  715.            my $b=new Gtk::OptionMenu;
  716.            $b->set_menu(new Gimp::UI::ImageMenu(sub {1},-1,\$res));
  717.            $a->pack_start ($b,1,1,0);
  718.            push(@setvals,sub{});
  719.            push(@getvals,sub{$res});
  720.            set_tip $t $b,$desc;
  721.            
  722. #           my $c = new Gtk::Button "Load";
  723. #           signal_connect $c "clicked", sub {$res = 2; main_quit Gtk};
  724. ##           $g->attach($c,1,2,$res,$res+1,{},{},4,2);
  725. #           $a->pack_start ($c,1,1,0);
  726. #           set_tip $t $c,"Load an image into the Gimp";
  727.            
  728.         } elsif($type == PF_LAYER) {
  729.            my $res;
  730.            $a=new Gtk::OptionMenu;
  731.            $a->set_menu(new Gimp::UI::LayerMenu(sub {1},-1,\$res));
  732.            push(@setvals,sub{});
  733.            push(@getvals,sub{$res});
  734.            
  735.         } elsif($type == PF_CHANNEL) {
  736.            my $res;
  737.            $a=new Gtk::OptionMenu;
  738.            $a->set_menu(new Gimp::UI::ChannelMenu(sub {1},-1,\$res));
  739.            push(@setvals,sub{});
  740.            push(@getvals,sub{$res});
  741.            
  742.         } elsif($type == PF_DRAWABLE) {
  743.            my $res=13;
  744.            $a=new Gtk::OptionMenu;
  745.            $a->set_menu(new Gimp::UI::DrawableMenu(sub {1},-1,\$res));
  746.            push(@setvals,sub{});
  747.            push(@getvals,sub{$res});
  748.            
  749.         } elsif($type == PF_PATTERN) {
  750.            if ($gimp_10) {
  751.               &new_PF_STRING;
  752.            } else {
  753.               $a=new Gimp::UI::PatternSelect -active => defined $value ? $value : (Gimp->patterns_get_pattern)[0];
  754.               push(@setvals,sub{$a->set('active',$_[0])});
  755.               push(@getvals,sub{$a->get('active')});
  756.            }
  757.            
  758.         } elsif($type == PF_BRUSH) {
  759.            if ($gimp_10) {
  760.               &new_PF_STRING;
  761.            } else {
  762.               $a=new Gimp::UI::BrushSelect -active =>  defined $value ? $value : (Gimp->brushes_get_brush)[0];
  763.               push(@setvals,sub{$a->set('active',$_[0])});
  764.               push(@getvals,sub{$a->get('active')});
  765.            }
  766.            
  767.         } elsif($type == PF_GRADIENT) {
  768.            if ($gimp_10) {
  769.               &new_PF_STRING;
  770.            } else {
  771.               $a=new Gimp::UI::GradientSelect -active => defined $value ? $value : (Gimp->gimp_gradients_get_active)[0];
  772.               push(@setvals,sub{$a->set('active',$_[0])});
  773.               push(@getvals,sub{$a->get('active')});
  774.            }
  775.            
  776.         } elsif($type == PF_CUSTOM) {
  777.            my (@widget)=&$extra;
  778.            $a=$widget[0];
  779.            push(@setvals,$widget[1]);
  780.            push(@getvals,$widget[2]);
  781.            
  782.         } elsif($type == PF_FILE) {
  783.            &new_PF_STRING;
  784.            my $s = $a;
  785.            $a = new Gtk::HBox 0,5;
  786.            $a->add ($s);
  787.            my $b = new Gtk::Button __"Browse";
  788.            $a->add ($b);
  789.            my $f = new Gtk::FileSelection $desc;
  790.            $b->signal_connect (clicked => sub { $f->set_filename ($s->get_text); $f->show_all });
  791.            $f->ok_button    ->signal_connect (clicked => sub { $f->hide; $s->set_text ($f->get_filename) });
  792.            $f->cancel_button->signal_connect (clicked => sub { $f->hide });
  793.            
  794.         } elsif($type == PF_TEXT) {
  795.            $a = new Gtk::Frame;
  796.            my $h = new Gtk::VBox 0,5;
  797.            $a->add($h);
  798.            my $e = new Gtk::Text;
  799.            my %e;
  800.            %e = $$extra if ref $extra eq "HASH";
  801.  
  802.            my $sv = sub { 
  803.               my $t = shift,
  804.               $e->delete_text(0,-1);
  805.               $e->insert_text($t,0);
  806.            };
  807.            my $gv = sub {
  808.               $e->get_chars(0,-1);
  809.            };
  810.  
  811.            $h->add ($e);
  812.            $e->set_editable (1);
  813.  
  814.            my $buttons = new Gtk::HBox 1,5;
  815.            $h->add($buttons);
  816.  
  817.            my $load = new Gtk::Button __"Load"; $buttons->add($load);
  818.            my $save = new Gtk::Button __"Save"; $buttons->add($save);
  819.            my $edit = new Gtk::Button __"Edit"; $buttons->add($edit);
  820.  
  821.            $edit->signal_connect(clicked => sub {
  822.               my $editor = $ENV{EDITOR} || "vi";
  823.               my $tmp = Gimp->temp_name("txt");
  824.               open TMP,">$tmp" or die __"FATAL: unable to create $tmp: $!\n"; print TMP &$gv; close TMP;
  825.               $w->hide;
  826.               main_iteration Gtk;
  827.               system ('xterm','-T',"$editor: $name",'-e',$editor,$tmp);
  828.               $w->show;
  829.               if (open TMP,"<$tmp") {
  830.                  local $/; &$sv(scalar<TMP>); close TMP;
  831.               } else {
  832.                  Gimp->message(__"unable to read temporary file $tmp: $!");
  833.               }
  834.            });
  835.  
  836.            my $filename = ($e{prefix} || eval { Gimp->directory } || ".") . "/";
  837.            
  838.            my $f = new Gtk::FileSelection __"Fileselector for $name";
  839.            $f->set_filename($filename);
  840.            $f->cancel_button->signal_connect (clicked => sub { $f->hide });
  841.            my $lf =sub {
  842.               $f->hide;
  843.               my $fn = $f->get_filename;
  844.               if(open TMP,"<$fn") {
  845.                  local $/; &$sv(scalar<TMP>);
  846.                  close TMP;
  847.               } else {
  848.                  Gimp->message(__"unable to read '$fn': $!");
  849.               }
  850.            };
  851.            my $sf =sub {
  852.               $f->hide;
  853.               my $fn = $f->get_filename;
  854.               if(open TMP,">$fn") {
  855.                  print TMP &$gv;
  856.                  close TMP;
  857.               } else {
  858.                  Gimp->message(__"unable to create '$fn': $!");
  859.               }
  860.            };
  861.            my $lshandle;
  862.            $load->signal_connect (clicked => sub {
  863.               $f->set_title(__"Load $name");
  864.               $f->ok_button->signal_disconnect($lshandle) if $lshandle;
  865.               $lshandle=$f->ok_button->signal_connect (clicked => $lf);
  866.               $f->show_all;
  867.            });
  868.            $save->signal_connect (clicked => sub {
  869.               $f->set_title(__"Save $name");
  870.               $f->ok_button->signal_disconnect($lshandle) if $lshandle;
  871.               $lshandle=$f->ok_button->signal_connect (clicked => $sf);
  872.               $f->show_all;
  873.            });
  874.  
  875.            push @setvals,$sv;
  876.            push @getvals,$gv;
  877.  
  878.         } else {
  879.            $label=__"Unsupported argumenttype $type";
  880.            push(@setvals,sub{});
  881.            push(@getvals,sub{$value});
  882.         }
  883.         
  884.         push(@lastvals,$value);
  885.         push(@defaults,$default);
  886.         $setvals[-1]->($value);
  887.         
  888.         $label=new Gtk::Label $label;
  889.         $label->set_alignment(0,0.5);
  890.         $g->attach($label,0,1,$res,$res+1,{},{},4,2);
  891.         $a && do {
  892.            set_tip $t $a,$desc;
  893.            $g->attach($a,1,2,$res,$res+1,["expand","fill"],["expand","fill"],4,2);
  894.         };
  895.         $res++;
  896.      }
  897.      
  898.      my $v = new Gtk::HBox 0,4;
  899.      $w->vbox->pack_start($v,0,0,4);
  900.  
  901.      my $hbbox=new Gtk::HButtonBox;
  902.      $hbbox->set_spacing(4);
  903.      $v->pack_end($hbbox,0,0,2);
  904.      
  905.      $button = new Gtk::Button __"Defaults";
  906.      signal_connect $button "clicked", sub {
  907.        for my $i (0..$#defaults) {
  908.          $setvals[$i]->($defaults[$i]);
  909.        }
  910.      };
  911.      $hbbox->pack_start($button,0,0,0);
  912.      set_tip $t $button,__"Reset all values to their default";
  913.      
  914.      $button = new Gtk::Button __"Previous";
  915.      signal_connect $button "clicked", sub {
  916.        for my $i (0..$#lastvals) {
  917.          $setvals[$i]->($lastvals[$i]);
  918.        }
  919.      };
  920.      $hbbox->pack_start($button,0,0,0);
  921.      set_tip $t $button,__"Restore values to the previous ones";
  922.      
  923.      signal_connect $w "destroy", sub { main_quit Gtk };
  924.  
  925.      my $hbbox = new Gtk::HButtonBox;
  926.      $hbbox->set_spacing(4);
  927.      $w->action_area->pack_start($hbbox,0,0,0);
  928.      show $hbbox;
  929.  
  930.      $button = new Gtk::Button __"Help";
  931.      $hbbox->pack_start($button,0,0,0);
  932.      signal_connect $button "clicked", sub { help_window($helpwin,$blurb,$help) };
  933.      can_default $button 1;
  934.      
  935.      my $hbbox = new Gtk::HButtonBox;
  936.      $hbbox->set_spacing(4);
  937.      $w->action_area->pack_end($hbbox,0,0,0);
  938.      show $hbbox;
  939.  
  940.      $button = new Gtk::Button __"OK";
  941.      signal_connect $button "clicked", sub {$res = 1; hide $w; main_quit Gtk};
  942.      $hbbox->pack_start($button,0,0,0);
  943.      can_default $button 1;
  944.      grab_default $button;
  945.      add $accel 0xFF0D, [], [], $button, "clicked";
  946.      
  947.      $button = new Gtk::Button __"Cancel";
  948.      signal_connect $button "clicked", sub {hide $w; main_quit Gtk};
  949.      $hbbox->pack_start($button,0,0,0);
  950.      can_default $button 1;
  951.      add $accel 0xFF1B, [], [], $button, "clicked";
  952.      
  953.      $res=0;
  954.      
  955.      show_all $w;
  956.      main Gtk;
  957.      
  958.      if ($res == 0) {
  959.         @res = ();
  960.         last;
  961.      }
  962.      @_ = map {&$_} @getvals;
  963.      if ($res == 1) {
  964.         @res = (1,@_);
  965.         last;
  966.      }
  967. #     Gimp->file_load(&Gimp::RUN_INTERACTIVE,"","");
  968.    }
  969.    @getvals=
  970.    @setvals=
  971.    @lastvals=();
  972.    @res;
  973. }
  974.  
  975. 1;
  976.  
  977. =head1 AUTHOR
  978.  
  979. Marc Lehmann <pcg@goof.com>. The ColorSelectButton code (now
  980. rebundled into the Gtk module) is written by Dov Grobgeld
  981. <dov@imagic.weizmann.ac.il>, with modifications by Kenneth Albanowski
  982. <kjahds@kjahds.com>.
  983.  
  984. =head1 SEE ALSO
  985.  
  986. perl(1), L<Gimp>.
  987.  
  988. =cut
  989.